home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / encorsrc.lha / encore_sources / sys / recognize.t < prev    next >
Text File  |  1988-05-02  |  6KB  |  158 lines
  1. (herald recognize
  2.   (env tsys (osys readtable)))
  3.  
  4. ;;; Copyright (c) 1985 Yale University
  5. ;;;     Authors: N Adams, R Kelsey, D Kranz, J Philbin, J Rees.
  6. ;;; This material was developed by the T Project at the Yale University Computer 
  7. ;;; Science Department.  Permission to copy this software, to redistribute it, 
  8. ;;; and to use it for any purpose is granted, subject to the following restric-
  9. ;;; tions and understandings.
  10. ;;; 1. Any copy made of this software must include this copyright notice in full.
  11. ;;; 2. Users of this software agree to make their best efforts (a) to return
  12. ;;;    to the T Project at Yale any improvements or extensions that they make,
  13. ;;;    so that these may be included in future releases; and (b) to inform
  14. ;;;    the T Project of noteworthy uses of this software.
  15. ;;; 3. All materials developed as a consequence of the use of this software
  16. ;;;    shall duly acknowledge such use, in accordance with the usual standards
  17. ;;;    of acknowledging credit in academic research.
  18. ;;; 4. Yale has made no warrantee or representation that the operation of
  19. ;;;    this software will be error-free, and Yale is under no obligation to
  20. ;;;    provide any services, by way of maintenance, update, or otherwise.
  21. ;;; 5. In conjunction with products arising from the use of this material,
  22. ;;;    there shall be no use of the name of the Yale University nor of any
  23. ;;;    adaptation thereof in any advertising, promotional, or sales literature
  24. ;;;    without prior written consent from Yale in each case.
  25. ;;;
  26.  
  27. ;;;; recognizers for numbers
  28.  
  29. ;;; This is used by the reader, to decide whether something's a
  30. ;;; number or not, and by the printer, to decide whether it needs
  31. ;;; to slashify a symbol.
  32.  
  33. ;;; El hacko versions to use until continuation-passing is really
  34. ;;; cheap, or until we have a good regular-expression package, or
  35. ;;; whatever.  this is not intended to be clean or final in any
  36. ;;; sense.
  37.  
  38. ;;; what about recognizing 15./29. for ratios?  hmm.  later.
  39.  
  40. ;;; main entry point:
  41.  
  42. (define (recognize-atom s rt)                ; ad hac
  43.   (let ((c (char s))
  44.         (radix (rt-radix rt)))
  45.     (or (cond ((char= c dot-char)
  46.                (cond ((fx= (string-length s) 1) parses-as-dot)
  47.                      (else (recognize-fraction (chdr s)))))
  48.               ((%digit? c (if (fx< radix 10) 10 radix))
  49.                (recognize-number (chopy s) rt))
  50.               ((fx= (string-length s) 1) nil)   ; + and - aren't numbers
  51.               ((sign-char? c)
  52.                (recognize-signed-number (chdr s) rt))
  53.               (else nil))
  54.         parses-as-symbol)))
  55.  
  56. (define (recognize-signed-number s rt)
  57.   ;; sign has been gobbled.  dispatch on next character.
  58.   (let ((c (char s)))
  59.     (cond ((char= c dot-char)
  60.            (recognize-fraction (chdr s)))
  61.           ((%digit? c (let ((radix (rt-radix rt)))
  62.                         (if (fx< radix 10) 10 radix)))
  63.            (recognize-number s rt))
  64.           (else nil))))
  65.  
  66. (define (recognize-number s rt)
  67.   ;; determine radix: if there are e's or dots, then base 10
  68.   ;; else given radix.
  69.   (let ((radix (cond ((or (string-posq #\. s)
  70.                           (and (fx< (rt-radix rt) 15)
  71.                                (or (string-posq #\E s)
  72.                                    (string-posq #\e s))))
  73.                       10)
  74.                      (else (rt-radix rt)))))
  75.     ;; scan over initial digits.
  76.     (iterate loop ()
  77.       (cond ((string-empty? s) parses-as-integer)
  78.             (else
  79.              (let ((c (char s)))
  80.                (chdr! s)
  81.                (cond ((%digit? c radix)
  82.                       (loop))
  83.                      ((char= c #\.)
  84.                       (cond ((string-empty? s)
  85.                              parses-as-decimal-integer)
  86.                             (else
  87.                              (recognize-optional-fraction s))))
  88.                      ((exponent-introducer? c)
  89.                       (recognize-float-exponent s))
  90.                      ((char= c ratio-char)
  91.                       (if (recognize-integer s radix)
  92.                           parses-as-ratio nil))
  93.                      (else nil))))))))
  94.  
  95. (define (recognize-fraction s)
  96.   ;; dot has already been gobbled.  digits must follow.
  97.   (cond ((%digit? (char s) 10)
  98.          (recognize-optional-fraction s))
  99.         (else nil)))
  100.  
  101. (define (recognize-optional-fraction s)
  102.   (iterate loop ()
  103.     (cond ((string-empty? s) parses-as-float)
  104.           (else
  105.            (let ((c (char s)))
  106.              (chdr! s)
  107.              (cond ((%digit? c 10) (loop))
  108.                    ((exponent-introducer? c) (recognize-float-exponent s))
  109.                    (else nil)))))))
  110.  
  111. (define (recognize-float-exponent s)
  112.   ;; e has already been gobbled.
  113.   (cond ((string-empty? s) parses-as-float)
  114.         (else (if (sign-char? (char s)) (chdr! s))
  115.               (if (recognize-integer s 10) parses-as-float nil))))
  116.  
  117. (define (recognize-integer s radix)
  118.   (cond ((string-empty? s) nil)
  119.         (else
  120.          (iterate loop ()
  121.            (let ((c (char s)))
  122.              (chdr! s)
  123.              (cond ((not (%digit? c radix)) nil)
  124.                    ((string-empty? s) parses-as-integer)
  125.                    (else (loop))))))))
  126.  
  127. (define parses-as-dot
  128.   (lambda (s rt) (ignore s rt) dot-token))
  129.  
  130. (define parses-as-symbol
  131.   (lambda (s rt)
  132.     ((rt-string->symbol rt) s)))
  133.  
  134. (define parses-as-integer
  135.   (lambda (s rt)
  136.     (string->integer s (rt-radix rt))))      ; defined in bignum module
  137.  
  138. (define parses-as-decimal-integer
  139.   (lambda (s rt)
  140.     (ignore rt)
  141.     (let ((s (chopy s)))
  142.       (set (string-length s) (fx- (string-length s) 1))
  143.       (string->integer s 10))))
  144.  
  145. (define parses-as-float
  146.   (lambda (s rt)
  147.     (ignore rt)
  148.     (string->flonum s)))
  149.  
  150. (define parses-as-ratio
  151.   (lambda (s rt)
  152.     (let ((s1 (chopy s))
  153.           (q (string-posq ratio-char s))
  154.           (radix (rt-radix rt)))
  155.       (set (string-length s1) q)
  156.       (ratio (string->integer s1                    radix)
  157.              (string->integer (nthchdr s (fx+ q 1)) radix)))))
  158.